package Quitz::Core::DataAccess;
# $Id: DataAccess.pm 7 2007-01-10 17:39:21Z nbachiyski $

use strict;
use warnings;

use Symbol;
use Class::Multimethods;

use Quitz::Core::AccessToken;
use Quitz::Core::Exceptions;
use Exception::Class
	(
		'Quitz::Core::AccessDenied' => { isa => 'Quitz::Core::Exception' },
		'Quitz::Core::ENoSuchUser' => { isa => 'Quitz::Core::Exception' },
	);
use Exception::Class::TryCatch;


#
# Method and hierchary creators
#

sub make_modifier($$$$)
{
	my ($name, $getcat, $desired_access, $code) = @_;
	return sub
	{
		my ($self, @params) = @_;
		my $owner = $self -> {owner};
		my $access_token = $owner -> access_token;
		my $dbaccess = $owner -> schema;
		my $cat = (ref $getcat eq 'CODE') ? &$getcat($self, @params) : $getcat;
		my $checkresult = (defined $cat) ?
			($access_token -> permit($cat, $desired_access)) :
			($access_token -> allow($desired_access));
		if ($checkresult)
		{
			return &$code($self, @params);
		}
		else
		{
			my $class = ref $self;
			throw Quitz::Core::AccessDenied( error => "Can't ${class}::$name : access is denied." );
		}
	}
}

sub make_reader
{
	my $name = shift;
	sub { return shift -> {data} -> $name(); };
}

sub make_writer
{
	my ($name, $getcat, $rights) = @_;
	return make_modifier $name, $getcat, $rights, sub
	{
		my $self = shift;
		$self -> {data} -> $name(@_);
	};
	
}

sub construct_object
{
	my ($class, $owner, $cache, $data) = @_;
	my $result = bless { owner => $owner, data => $data }, $class;
	$owner -> {$cache} -> {$result -> {data} -> id } = $result;
	return $result;
}

sub install_methods
{
	my ($class, %methods) = @_;
	while (my ($name, $code) = each %methods)
	{
		my $methodglob = Symbol::qualify_to_ref($class . '::' . $name);
		$$methodglob = $code;
	}
}

sub install_children
{
	my ($parent, @children) = @_;
	foreach my $child (@children)
	{
		my $ISAglob = Symbol::qualify_to_ref($child . '::ISA');
		push @$$ISAglob, $parent;
	}
}

sub install_readers
{
	my ($class, %names) = @_;
	while (my ($accessor, $field) = each %names)
	{
		my $methodglob = Symbol::qualify_to_ref($class . '::' . $accessor);
		$$methodglob = make_reader($field);
	}
}

sub install_writers
{
	my ($class, @params) = @_;
	my $me = __PACKAGE__;
	my $installclass = $class;
	$installclass =~ s/^${me}:://;
	while (scalar @params)
	{
		my ($accessor, $getcat, $rights) = splice @params, 0, 3;
		multimethod $installclass . '::' . $accessor => ($class) => make_reader $accessor;
		multimethod $installclass . '::' . $accessor => ($class, '*') => make_writer $accessor, $getcat, $rights;
	}
}

#
# Setup
#

our $UserAccessClass;
our $CategoryAccessClass;
our ($UserClassName, $CategoryClassName, $QuestionClassName, $AnswerClassName) =
	qw(User Category Question Answer);

our $UserClass = __PACKAGE__ . '::' . $UserClassName;
our $CategoryClass = __PACKAGE__ . '::' . $CategoryClassName;

sub setup_class
{
	my $class = shift;
	my $me = __PACKAGE__;
	my $UserAccess = 'UserAccess';
	my $CategoryAccess = 'CategoryAccess';
	$UserAccessClass = $class . '::' . $UserAccess;
	$CategoryAccessClass = $class . '::' . $CategoryAccess;

	#
	# Exception classes
	#
	foreach ($UserClassName, $CategoryClassName, $QuestionClassName, $AnswerClassName)
	{
		my $ExceptionName = 'Quitz::Core::ENoSuch' . $_;
		import Exception::Class $ExceptionName => { isa => 'Quitz::Core::Exception' } ;
	}

	#
	# Category methods: open, create, name, id, parent_id
	#
	install_methods $CategoryClass,
		open => make_modifier('open', sub { $_[1] }, S_READ, sub
		{
			my ($self, $id) = @_;
			my $owner = $self -> owner;
			if ($owner -> {open_categories} -> {$id})
			{
				return $owner -> {open_categories} -> {$id};
			}
			my $data = $owner -> schema -> resultset('Category') -> find($id);
			throw Quitz::Core::ENoSuchCategory( error => "No such category: `$id'" ) unless defined $data;
			construct_object($CategoryClass, $owner, 'open_categories', $data);
		}),
		create => make_modifier('create', sub { shift -> {data} }, S_READ | S_WRITE, sub
		{
			my ($self, $name) = @_;
			my $owner = $self -> owner;
			construct_object
			(
				$CategoryClass, $owner, 'open_categories',
				$owner -> schema -> resultset('Category') -> create({ parent_id => $self -> id, name => ($name || '') })
			);
		}),
		DESTROY => sub { shift -> update() };

	install_readers $CategoryClass, id => 'id', parent_id => 'parent_id', update => 'update';
	install_writers $CategoryClass,
		name => sub { shift } => S_READ | S_WRITE;

	#
	# User methods: name, id
	#
	install_methods $UserClass, DESTROY => sub { shift -> update() };
	install_readers $UserClass, name => 'username', id => 'id', update => 'update';

	#
	# User access methods: open, openid, create
	#
	install_methods $UserAccessClass,
		open => make_modifier('open', undef, S_INSPECT, sub
		{
			my ($self, $name) = @_;
			my $owner = $self -> owner;
			my $data = $owner -> schema -> resultset('User') -> search({ username => $name }) -> first();
			throw Quitz::Core::ENoSuchUser( error => "No such user: `$name'" ) unless defined $data;
			construct_object($UserClass, $owner, 'open_users', $data);
		}),
		openid => make_modifier('openid', undef, S_INSPECT, sub
		{
			my ($self, $id) = @_;
			my $owner = $self -> owner;
			my $data = $owner -> schema -> resultset('User') -> find($id);
			throw Quitz::Core::ENoSuchUser(error => "No user with such id: `$id'") unless defined $data;
			construct_object($UserClass, $owner, 'open_users', $data);
		});

	multimethod $UserAccess . '::create' => ($UserAccessClass, '*', '*') => \&create_user_with_rights;
	multimethod $UserAccess . '::create' => ($UserAccessClass, '*', '*', '*') => \&create_user_with_rights;

	install_methods $UserAccessClass, owner => sub { shift -> {owner} };

	#
	# Category Access methods: open
	#
	install_methods $CategoryAccessClass,
		open => $CategoryClass -> can('open'),
		owner => sub { shift -> {owner} };
	install_methods $class,
		categories => sub { shift -> {categories} },
		users => sub { shift -> {users} };
}

sub setup_object
{
	my $object = shift;
	$object -> {categories} = bless { owner => $object }, $CategoryAccessClass;
	$object -> {users} = bless { owner => $object }, $UserAccessClass;
}

sub create_user_with_rights
{
	my ($self, $username, $password, $rights) = @_;
	my $owner = $self -> owner;
	if (defined $rights)
	{
		$rights = $rights & (S_INSPECT | S_CREATE | S_GRANT);
	}
	my $newuser = $owner -> schema -> resultset('User') -> create
	({
		username => $username,
		password => $password,
		generic_rights => $rights || 0,
	});
	my $result = construct_object($UserClass, $owner, 'open_users', $newuser);
	return $result;

}

1;
